home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / print / pputil.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  3.4 KB  |  106 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. (* basics/pputil.sml *)
  3.  
  4. structure PPUtil : PPUTIL =
  5. struct
  6.  
  7.   structure Symbol : SYMBOL = Symbol
  8.   structure PP = PrettyPrint
  9.  
  10.   fun ppSequence0 ppstream (sep:PP.ppstream->unit,pr,elems) =
  11.       let fun prElems [el] = pr ppstream el
  12.         | prElems (el::rest) =
  13.             (pr ppstream el;
  14.          sep ppstream;
  15.                  prElems rest)
  16.         | prElems [] = ()
  17.        in prElems elems
  18.       end
  19.  
  20.   fun ppSequence ppstream {sep:PP.ppstream->unit, pr:PP.ppstream->'a->unit, 
  21.                            style:PP.break_style} (elems: 'a list) =
  22.       (PP.begin_block ppstream style 0;
  23.        ppSequence0 ppstream (sep,pr,elems);
  24.        PP.end_block ppstream)
  25.  
  26.   fun ppClosedSequence ppstream{front:PP.ppstream->unit,sep:PP.ppstream->unit,
  27.                                back:PP.ppstream->unit,pr:PP.ppstream->'a->unit,
  28.                                 style:PP.break_style} (elems:'a list) =
  29.       (PP.begin_block ppstream PP.CONSISTENT 0;
  30.        front ppstream;
  31.        PP.begin_block ppstream style 0;
  32.        ppSequence0 ppstream (sep,pr,elems); 
  33.        PP.end_block ppstream;
  34.        back ppstream;
  35.        PP.end_block ppstream)
  36.  
  37.   fun ppSym ppstream (s:Symbol.symbol) = PP.add_string ppstream (Symbol.name s)
  38.  
  39.   fun formatQid p =
  40.     let fun f [s] = [Symbol.name s]
  41.           | f (a::r) = Symbol.name a :: "." :: f r
  42.           | f nil = ["<bogus qid>"]
  43.      in implode(f p)
  44.     end
  45.  
  46.   val stringDepth = System.Print.stringDepth
  47.  
  48.   fun decimal i = let val m = Integer.makestring
  49.           in  m(i div 100)^m((i div 10)mod 10)^m(i mod 10) end
  50.   val ctrl_a = 1
  51.   val ctrl_z = 26
  52.   val offset = ord "A" - ctrl_a
  53.   val smallestprintable = ord " "
  54.   val biggestprintable = ord "~"
  55.   fun ml_char "\n" = "\\n"
  56.     | ml_char "\t" = "\\t"
  57.     | ml_char "\\" = "\\\\"
  58.     | ml_char "\"" = "\\\""
  59.     | ml_char c =
  60.       let val char = ord c
  61.       in  if char >= ctrl_a andalso char <= ctrl_z
  62.           then "\\^" ^ chr(char+offset)
  63.           else if char >= smallestprintable andalso char <= biggestprintable
  64.            then c
  65.           else "\\" ^ decimal char
  66.       end
  67.  
  68.   fun mlstr s = "\"" ^ implode(map ml_char (explode s)) ^ "\""
  69.   fun pp_mlstr ppstream s =
  70.       let val depth = !stringDepth
  71.           val add_string = PP.add_string ppstream
  72.       fun pr i =
  73.           if i=depth then add_string "#"
  74.           else (let val ch = substring(s,i,1)
  75.             in  add_string (ml_char ch); pr (i+1)
  76.             end handle Substring => ())
  77.       in add_string "\""; pr 0; add_string "\""
  78.       end
  79.  
  80.   fun ppvseq ppstream ind (sep:string) pr elems =
  81.       let fun prElems [el] = pr ppstream el
  82.         | prElems (el::rest) = (pr ppstream el; 
  83.                                     PP.add_string ppstream sep; 
  84.                                     PP.add_newline ppstream;
  85.                                     prElems rest)
  86.         | prElems [] = ()
  87.        in PP.begin_block ppstream PP.CONSISTENT ind;
  88.           prElems elems;
  89.           PP.end_block ppstream
  90.       end
  91.  
  92.   (* debug print functions *)
  93.   fun ppIntPath ppstream =
  94.         ppClosedSequence ppstream 
  95.       {front=(fn pps => PP.add_string pps "["),
  96.        sep=(fn pps => (PP.add_string pps ","; PP.add_break pps (0,0))),
  97.        back=(fn pps => PP.add_string pps "]"),
  98.        style=PP.INCONSISTENT,
  99.        pr=(fn pps => PP.add_string pps o (makestring:int->string))}
  100.   fun ppSymPath ppstream = 
  101.      ppSequence ppstream {sep=(fn pps => PP.add_string pps "."),
  102.               style=PP.INCONSISTENT,
  103.               pr=ppSym}
  104.  
  105. end (* structure PPUtil *)
  106.